home *** CD-ROM | disk | FTP | other *** search
/ The 640 MEG Shareware Studio 5 / The 640 Meg Shareware Studio CD-ROM Volume V (Data Express)(1994).ISO / amiga / rfs156.lha / rexx / RFS.rexx next >
OS/2 REXX Batch file  |  1994-03-27  |  27KB  |  624 lines
  1. /**/
  2. v="$VER: RFS Rexx WPL Mailer File Request Server  Williamson 50.75"
  3. Parse Arg wplport Line baud host_address Infile Listed remote_address remote_sysop
  4. if arg()=0 then EXIT
  5. script="RFS"
  6. xfq_site_object=XfqGetAddress(remote_address)
  7. if ~XfqHoldMailer(xfq_site_object) then do
  8.     address "LOGPROC" 'Putlog 'loggroup time() Line script 'HOLD Failed:'XFQERRORMSG remote_address
  9.     drop XFQERRORCODE XFQERRORMSG
  10. end
  11. TRUE=1;FALSE=0
  12. verbose=FALSE;debug=FALSE /*if debug TRUE, files not queued, req not deleted*/
  13. Options failat 99
  14. Options Results
  15. Signal On Syntax
  16. Signal On IOErr
  17. sv="v"||right(v,5)
  18. if upper(wplport)="DEBUG" then do
  19.     Parse Arg junk wplport Line Baud host_address Infile Listed remote_address remote_sysop
  20.     verbose=TRUE;debug=TRUE;loggroup='RFS'
  21.     address "LOGPROC" 
  22.     'OpenLog RFS w RAW:0/0/600/200/RFS'
  23.     'AddLogGroup RFS RFS'
  24.     'Putlog 'loggroup time() Line script 'Debug Enabled'
  25.     address
  26. end
  27.  
  28. cr='0d'X;lf="0a"x;quote='"'
  29. LogBuf="";AccBuf="";MsgBuf=""
  30. if debug then loggroup="RFS"
  31. else loggroup=lower(wplport)||"wpl"
  32. call setconfig
  33.  
  34. if Priority~=0 then oldpri=Pragma('Priority',Priority)
  35. parse var remote_address hisaddress.domain '#' hisaddress.zone ':' hisaddress.net '/' hisaddress.node '.' hisaddress.point
  36. remote_sysop=strip(remote_sysop)
  37. if remote_sysop="" then remote_sysop="Unknown Sysop"
  38. address "LOGPROC" 'Putlog 'loggroup time() Line script sv 'Serving 'remote_sysop' of 'remote_address' on 'upper(wplport)||line
  39. LogBuf=LogBuf||date() time()' RFS Serving 'remote_sysop' of 'remote_address' on 'upper(wplport)||line||lf
  40.  
  41. XQ_DELETE=1     /* Delete file after sending             */
  42. XQ_IMMEDIATE=4  /* Send only if session currently up     */
  43. DTPRI_CRASH=50
  44.  
  45. tlist="T:rfs_t"||Line;ulist="T:rfs_u"||Line
  46. a=0;b=0;i=0;x=0 ;Sent=0;TBytes=0
  47.  
  48. parse var host_address myaddress.domain '#' myaddress.zone ':' myaddress.net '/' myaddress.node '.' myaddress.point
  49.  
  50. if pos("GRAB",InFile) >0 | pos('_',remote_address) >0 then do
  51.     Human=TRUE
  52.     AcctPath=AcctPath||"H/"    
  53.     if ~listed then MaxBytes=MaxHBytes
  54.     else do
  55.         MaxDaily=MaxBytes
  56.         MaxBytes=baud*100
  57.     end
  58. end
  59. else Human=FALSE
  60.  
  61. /* exclusion processing */
  62. if debug then address "LOGPROC" 'Putlog 'loggroup time() Line "Exclusion processing"
  63. if ~ReqHuman & Human then do
  64.     address "LOGPROC" 'Putlog 'loggroup time() Line "Refusing Request! Humans excluded!"
  65.     LogBuf=LogBuf||date() time() Line' Refusing request from 'remote_sysop' of 'remote_address' -> Humans excluded'||lf
  66.     call writepkt('File request terminated: Humans are excluded at this time.'||cr)
  67.     Signal GoodBye
  68. end
  69. if ~ReqPoint & (hisaddress.point > "0") then do
  70.     address "LOGPROC" 'Putlog 'loggroup time() Line "Refusing Request! Points Not Supported!"
  71.     LogBuf=LogBuf||date() time() Line' Refusing request from 'remote_sysop' of 'remote_address' -> Points Not Allowed'||lf
  72.     call writepkt('File request terminated: Points are not currently served.'||cr)
  73.     Signal GoodBye
  74. end
  75.  
  76. if ~ReqUnlisted & ~Listed & ~Human then do
  77.     address "LOGPROC" 'Putlog 'loggroup time() Line "Refusing Request! Unlisted Systems Not Supported!"
  78.     LogBuf=LogBuf||date() time() Line' Refusing request from 'remote_sysop' of 'remote_address' -> Unlisted System'||lf
  79.     call writepkt('File request terminated: Unlisted System ('remote_address')'||cr)
  80.     Signal GoodBye
  81. end
  82.  
  83. if EXCLUDE.0~=0 then
  84. do zz=1 to EXCLUDE.0
  85.     if upper(remote_address)=upper(Exclude.zz) then do
  86.         address "LOGPROC" 'Putlog 'loggroup time() Line "Refusing Request! Excluded Node!"
  87.         LogBuf=LogBuf||date() time() Line' Refusing request from 'remote_sysop' of 'remote_address' -> Excluded Node!'||lf
  88.         call writepkt('File request terminated: Your system is not authorized to request files here.'||cr)
  89.         Signal GoodBye
  90.     end
  91. end
  92.  
  93. /* Read Accounting Data */
  94. AcctFile=AcctPath||translate(remote_address,'...','#:/')
  95. if exists(AcctFile) then do
  96.     if verbose then address "LOGPROC" 'Putlog 'loggroup time() Line "Reading Accounting Information"
  97.     call open('Acct',AcctFile,'R')
  98.     FirstDate=readln('Acct')
  99.     LastDate=readln('Acct')
  100.     NumReqs =readln('Acct')
  101.     ReqFiles=readln('Acct')
  102.     ReqBytes=readln('Acct')
  103.     LastBytes=readln('Acct')
  104.     UserCalls=readln('Acct')
  105.     call close('Acct')
  106.     if LastDate=Date() then UserCalls=UserCalls+1
  107.     else do
  108.         LastBytes=0
  109.         UserCalls=0
  110.     end
  111. end;else do
  112.     FirstCall=""
  113.     FirstDate=Date();LastDate=Date()
  114.     NumReqs=0;ReqFiles=0;ReqBytes=0;LastBytes=0;UserCalls=0
  115. end
  116.  
  117. if Human & (UserCalls > MaxCalls) then do
  118.     address "LOGPROC" 'Putlog 'loggroup time() Line "Refusing Request! Human exceeded max calls!"
  119.     LogBuf=LogBuf||date() time() Line' Refusing request from 'remote_sysop' of 'remote_address' -> Humans exceeded max calls'||lf
  120.     call writepkt('File request terminated: Exceeded Maximum sessions per day.'||cr)
  121.     Signal GoodBye
  122. end
  123.  
  124. /* Read the REQ file */
  125. if verbose then address "LOGPROC" 'Putlog 'loggroup time() Line "Reading "Infile 
  126. NumRequested=1
  127. if ~open('in',Infile,'R') then do
  128.     address "LOGPROC" 'Putlog 'loggroup time() Line "Unable to read "Infile
  129.     LogBuf=LogBuf||date() time() Line Infile' from 'remote_sysop' of 'remote_address' -> Not Found'||lf
  130.     Signal GoodBye
  131. end
  132. do while ~eof('in')
  133.     FName.NumRequested=upper(readln('in'))
  134.     MName.NumRequested=""
  135.     if left(FName.NumRequested,1)=";" then iterate
  136.     if left(FName.NumRequested,3)="---" then iterate
  137.     if right(FName.NumRequested,1)=D2C('13') then FName.NumRequested=left(FName.NumRequested,Length(FName.NumRequested)-1)
  138.     if length(FName.NumRequested) < 1 then leave
  139.     Update.NumRequested=""
  140.     Password.NumRequested=""
  141.     if words(FName.NumRequested) > 1 then do
  142.         if left(word(FName.NumRequested,2),1)="!" then Password.NumRequested=SubStr(Word(FName.NumRequested,2),2)
  143.         if left(word(FName.NumRequested,2),1)="+" then Update.NumRequested=Word(FName.NumRequested,2)
  144.         else if left(word(FName.NumRequested,2),1)="-" then Update.NumRequested=Word(FName.NumRequested,2)
  145.         else if words(FName.NumRequested)=3 then do    
  146.             if left(word(FName.NumRequested,3),1)="!" then Password.NumRequested=SubStr(Word(FName.NumRequested,3),2)
  147.             if left(word(FName.NumRequested,3),1)="+" then Update.NumRequested=Word(FName.NumRequested,3)
  148.             else if left(word(FName.NumRequested,3),1)="-" then Update.NumRequested=Word(FName.NumRequested,3)
  149.         end
  150.         FName.NumRequested=word(FName.NumRequested,1)
  151.     end
  152.     NumRequested=NumRequested+1
  153. end
  154. call close('in')
  155. /* Number of Files Requested */
  156. NumRequested=NumRequested-1
  157.  
  158. if verbose then address "LOGPROC" 'Putlog 'loggroup time() Line "Requests:"NumRequested
  159.  
  160. /* Find requested files */
  161. call FindRequests
  162.  
  163. /* Send result message */
  164. if debug then address "LOGPROC" 'Putlog 'loggroup time() Line "Building Response message"
  165. do a=1 to NumRequested
  166.     if verbose then address "LOGPROC" 'Putlog 'loggroup time() Line "Request:"a Fname.a SendFName.a "Sent:"SendFName.a.SentFiles
  167.     
  168.     if (MaxReqNames > 0) & (a > MaxReqNames) then SendFName.a.SentFiles=1
  169.     do b=1 to SendFName.a.SentFiles
  170.         if verbose then address "LOGPROC" 'PutLog 'loggroup time() Line "Request:"a Fname.a "Sent:"SendFName.a.b
  171.         if SendFName.a.b="File Not Found" then do
  172.             MsgBuf=MsgBuf||'Request Number 'a  'Requested: 'FName.a||cr
  173.             MsgBuf=MsgBuf||'Error: File Not Found or Password Missing/Invalid'||cr||cr
  174.             LogBuf=LogBuf||date() time()' 'FName.a' -=> Error: File Not Found'||lf
  175.             iterate
  176.         end
  177.         if SendFName.a.b="File Not Available" then do
  178.             MsgBuf=MsgBuf||'Request Number 'a  'Requested: 'FName.a||cr
  179.             MsgBuf=MsgBuf||'Error: File Is Not Available On This System'||cr||cr
  180.             LogBuf=LogBuf||date() time()' 'FName.a' -=> Error: File Missing ['Password.a']'||lf
  181.             iterate
  182.         end
  183.         if SendFName.a.b="Bad Password" then do
  184.             MsgBuf=MsgBuf||'Request Number 'a  'Requested: 'FName.a||cr
  185.             MsgBuf=MsgBuf||'Error: File Not Found or Password Missing/Invalid'||cr||cr 
  186.             LogBuf=LogBuf||date() time()' 'FName.a' -=> Error: Bad Password ['Password.a']'||lf
  187.             iterate
  188.         end
  189.         if SendFName.a.b="Too Many Bytes" then do
  190.             MsgBuf=MsgBuf||'Request Number 'a  'Requested: 'FName.a||cr
  191.             MsgBuf=MsgBuf||'Error: Request Exceeded Maximum Requests or Byte count'||cr||cr 
  192.             LogBuf=LogBuf||date() time()' 'FName.a' -=> Error: Request Exceeded Byte count'||lf
  193.             iterate
  194.         end
  195.         if MaxReqNames>0 & a>MaxReqNames | SendFName.a.b="Too Many Requests" then do
  196.             MsgBuf=MsgBuf||'Request Number 'a  'Requested: 'FName.a||cr
  197.             MsgBuf=MsgBuf||'Error: Request Exceeded Maximum Requests or Byte count'||cr||cr 
  198.             LogBuf=LogBuf||date() time()' 'FName.a' -=> Error: Request Exceeded Maximum Requests'||lf
  199.             iterate
  200.         end
  201.         if SendFName.a.b="Exceeded Daily Limit" then do
  202.             MsgBuf=MsgBuf||'Request Number 'a  'Requested: 'FName.a||cr
  203.             MsgBuf=MsgBuf||'Error: Request Exceeded Daily Limit for Human requesters'||cr||cr 
  204.             LogBuf=LogBuf||date() time()' 'FName.a' -=> Error: Request Exceeded Daily Limit for Human requesters'||lf
  205.             iterate
  206.         end
  207.         if SubWord(SendFName.a.b,1,3)="Update request failed:" then do
  208.             MsgBuf=MsgBuf||'Request Number 'a  'Requested: 'FName.a||cr
  209.             MsgBuf=MsgBuf||'Date : 'JDate.a.b||cr||'Error: 'SendFName.a.b||cr||cr
  210.             LogBuf=LogBuf||date() time()' 'FName.a' -=> Error: 'SendFName.a.b||lf
  211.             iterate
  212.         end;else do
  213.             Sent=Sent+1
  214.             if MName.a.b~="" then do
  215.                 MsgBuf=MsgBuf||'Request Number 'a  'Requested: 'FName.a||' Sent:'MName.a.b||cr
  216.                 MsgBuf=MsgBuf||'Size : 'FSize.a.b' bytes'||cr||'Desc : 'FDesc.a.b||cr||cr
  217.                 LogBuf=LogBuf||date() time()' 'FName.a '['MName.a.b'] ('FSize.a.b' bytes)'||lf
  218.             end;else do
  219.                 MsgBuf=MsgBuf||'Request Number 'a  'Requested: 'FName.a||cr
  220.                 MsgBuf=MsgBuf||'Size : 'FSize.a.b' bytes'||cr||'Desc : 'FDesc.a.b||cr||cr
  221.                 LogBuf=LogBuf||date() time()' 'FName.a' ('FSize.a.b' bytes)'||lf
  222.             end
  223.         end
  224.     end
  225. end
  226.  
  227. if (MaxReqNames > 0) & (NumRequested > MaxReqNames) then do
  228.    MsgBuf=MsgBuf||'Remaining Requests skipped for exceeding request limits'||cr
  229. end
  230. MsgBuf=MsgBuf||cr||'Sending 'Sent' file(s), 'TBytes' bytes this request.'||cr
  231. MsgBuf=MsgBuf||cr||'You have made a total of 'NumReqs+1' FileRequest(s) for 'ReqFiles+Sent' files ('ReqBytes+TBytes' bytes)'||cr
  232. MsgBuf=MsgBuf||cr||'Files were requested from 'script sv' on 'host_address||cr
  233.  
  234. call writepkt(MsgBuf)
  235.  
  236. LogBuf=LogBuf||date() time()' Sending 'Sent' file(s), 'TBytes' bytes this request'||lf
  237. LogBuf=LogBuf||date() time()' Totals: 'NumReqs+1' request(s) for 'ReqFiles+Sent' file(s) ('ReqBytes+TBytes' bytes)'||lf
  238.  
  239. /* Update the account */
  240. AccBuf=AccBuf||FirstDate||lf||Date()||lf
  241. AccBuf=AccBuf||NumReqs+1||lf||ReqFiles+Sent||lf
  242. AccBuf=AccBuf||ReqBytes+TBytes||lf 
  243. AccBuf=Accbuf||LastBytes+TBytes||lf||UserCalls||lf
  244. Signal GoodBye
  245.  
  246. FindRequests:
  247. Num=NumRequested /* Limit number of REQUEST NAMES to MaxReqNames */
  248. if (MaxReqNames~=0) & (NumRequested > MaxReqNames) then Num=MaxReqNames
  249.  
  250. do ReqCount=1 to Num
  251. /*
  252.     if (Pos("#",FName.ReqCount) > 0) | (Pos("?",FName.ReqCount) > 0),
  253.      | (Pos("[",FName.ReqCount) > 0) | (Pos("]",FName.ReqCount) > 0),
  254.      | (Pos("(",FName.ReqCount) > 0) | (Pos(")",FName.ReqCount) > 0),
  255.      | (Pos("|",FName.ReqCount) > 0) | (Pos("~",FName.ReqCount) > 0),
  256.      | (Pos("%",FName.ReqCount) > 0) | (Pos("*",FName.ReqCount) > 0)
  257.      Then sopt="PATTERN"
  258.         else sopt=""
  259.  
  260.     if (Pos(".",FName.ReqCount) > 0) | sopt="PATTERN" then matchfirst=TRUE
  261.         else matchfirst=FALSE
  262. */
  263.     address "LOGPROC" 'PutLog 'loggroup time() Line script "Searching for Req:"ReqCount":"FName.ReqCount" in "FREQLST
  264.     SentCount=1;notfound=1
  265.     SendFName.ReqCount.SentCount="File Not Found"
  266.     if SortedLst=TRUE then sopt="-s"
  267.     if MatchFirst=TRUE then do
  268.         if verbose then address "LOGPROC" 'PutLog 'loggroup time() Line script "Executing: Fsearch >"tlist FREQLST Fname.ReqCount "-o" sopt
  269.         address COMMAND 'Fsearch >'tlist FREQLST Fname.ReqCount '-o' sopt
  270.     end;else do
  271.         if verbose then address "LOGPROC" 'PutLog 'loggroup time() Line script "Executing: Fsearch >"tlist FREQLST Fname.ReqCount sopt
  272.         address COMMAND 'Fsearch >'tlist FREQLST Fname.ReqCount sopt
  273.     end
  274.  
  275. /*
  276.     if RC=notfound  then do
  277.         SendFName.ReqCount.SentCount="File Not Found"
  278.         if verbose then address "LOGPROC" 'PutLog 'loggroup time() Line "SEARCH:["Fname.ReqCount"] NOT FOUND" ReqCount SentCount SendFName.ReqCount.SentCount
  279.  
  280.         if SentCount=0 then SendFname.ReqCount.SentFiles=1
  281.             else if SentCount > 1 then SendFname.ReqCount.SentFiles=SentCount-1  
  282.                 else SendFname.ReqCount.SentFiles=SentCount
  283.  
  284.         if verbose then address "LOGPROC" 'PutLog 'loggroup time() Line "Req:"ReqCount':'SendFname.ReqCount.SentFiles "SentCount:"SentCount 
  285.         iterate
  286.     end
  287. */
  288.     if verbose then address "LOGPROC" 'PutLog 'loggroup time() Line "Searching match list:"tlist
  289.     call open('tq',tlist,'r')
  290.     do while ~eof('tq')
  291.         SearchResult=strip(readln('tq'))
  292.         if SearchResult="" then Iterate
  293.         if SearchResult="!@ No match found" then do
  294.             SendFName.ReqCount.SentCount="File Not Found"
  295.             Leave
  296.         end
  297.         if verbose then address "LOGPROC" 'PutLog 'loggroup time() Line "SearchResult:"SearchResult
  298.         if MatchFirst=TRUE then do
  299.             /* if not a magic name then we send only the first file matched */
  300.             if verbose then address "LOGPROC" 'PutLog 'loggroup time() Line "MATCHFIRST:"SearchResult
  301.             call sendifok
  302.             Leave
  303.         end
  304.         if verbose then address "LOGPROC" 'PutLog 'loggroup time() Line "MULTIMATCH:"SentCount SearchResult
  305.         call sendifok
  306.         SentCount=SentCount+1
  307.         if MultiMagic=TRUE | MatchFirst=FALSE then Iterate
  308.             else Leave
  309.     end /* tag matches in search list */
  310.     call close('tq') 
  311.     if ~debug then call delete(tlist)
  312.     if SentCount=0 then SendFname.ReqCount.SentFiles=1
  313.         else if SentCount > 1 then SendFname.ReqCount.SentFiles=SentCount-1  
  314.             else SendFname.ReqCount.SentFiles=SentCount
  315.     if verbose then address "LOGPROC" 'PutLog 'loggroup time() Line "SentCount:"SentCount SendFname.ReqCount.SentFiles
  316. end /* each request NAME */
  317. Return
  318.  
  319. sendifok:
  320. /* check file match for bytes exceeded, password match, update request */
  321. sendit=TRUE
  322. if verbose then address "LOGPROC" 'PutLog 'loggroup time() Line "Checking:" SearchResult
  323. if index(SearchResult,'!')=0 then do
  324.     if verbose then address "LOGPROC" 'PutLog 'loggroup time() Line "No Password Set:" SearchResult
  325.     SendFname.ReqCount.SentCount=upper(subword(SearchResult,2))
  326. end;else do 
  327.     if verbose then address "LOGPROC" 'PutLog 'loggroup time() Line "Password Check:" SearchResult "{"upper(Password.ReqCount)"}"
  328.     if upper(Password.ReqCount)~=strip(upper(delstr(word(SearchResult,2),1,1))) then do
  329.         if verbose then address "LOGPROC" 'PutLog 'loggroup time() Line script "Bad Password!"
  330.         SendFName.ReqCount.SentCount="Bad Password"
  331.         sendit=FALSE
  332.     end;else do
  333.         SendFname.ReqCount.SentCount=upper(subword(SearchResult,3))
  334.     end
  335. end
  336.  
  337. if ~sendit then return sendit
  338.  
  339. if ~exists(SendFName.ReqCount.SentCount) then do
  340.     if verbose then address "LOGPROC" 'PutLog 'loggroup time() Line "File Missing:"SendFName.ReqCount.SentCount
  341.     SendFName.ReqCount.SentCount="File Not Available"
  342.     sendit=FALSE
  343. end;else do
  344.     FName.ReqCount.SentCount=get_fn(SendFName.ReqCount.SentCount)
  345.     filestats=statef(SendFName.ReqCount.SentCount)
  346.     FSize.ReqCount.SentCount=word(filestats,2)
  347.     if verbose then address "LOGPROC" 'PutLog 'loggroup time() Line FName.ReqCount.SentCount" Size:" FSize.ReqCount.SentCount
  348.     TBytes=TBytes+FSize.ReqCount.SentCount
  349.     if MaxBytes > 0 then do
  350.         if (TBytes > MaxBytes) then do
  351.             SendFName.ReqCount.SentCount="Too Many Bytes"
  352.             TBytes=TBytes-FSize.ReqCount.SentCount
  353.             sendit=FALSE
  354.         end
  355.     end
  356.  
  357.     if Human & (MaxDaily > 0) then do
  358.         if (TBytes+LastBytes > MaxDaily) then do
  359.             SendFName.ReqCount.SentCount="Exceeded Daily Limit"
  360.             TBytes=TBytes-FSize.ReqCount.SentCount
  361.             sendit=FALSE
  362.         end
  363.     end
  364.  
  365.     FDesc.ReqCount.SentCount=subword(filestats,8)
  366.     if FDesc.ReqCount.SentCount="" then FDesc.ReqCount.SentCount="Sorry, description is unavailable"
  367.  
  368.     if DLGfd then FDesc.ReqCount.SentCount=get_dlgfd()
  369.     else if TAdesc then FDesc.ReqCount.SentCount=get_tadesc()
  370.  
  371.     if Update.ReqCount ~="" then do
  372.         if verbose then address "LOGPROC" 'PutLog 'loggroup time() Line "Update Request:"Update.ReqCount
  373.         UDT.ReqCount=left(Update.ReqCount,1)
  374.         if substr(Update.ReqCount,2,1)="U" then do
  375.             Update.ReqCount=SubStr(Update.ReqCount,3)
  376.             UDT.Human=TRUE
  377.             if verbose then address "LOGPROC" 'PutLog 'loggroup time() Line "QS/RFS Update Request:"Update.ReqCount
  378.         end;else do
  379.             Update.ReqCount=SubStr(Update.ReqCount,2)
  380.             UDT.Human=FALSE
  381.             if verbose then address "LOGPROC" 'PutLog 'loggroup time() Line "FTS006 Update Request:"Update.ReqCount
  382.         end
  383.         if UDT.Human then do
  384.             if length(strip(Update.ReqCount)) >6 then do    
  385.                 cktime=TRUE
  386.                 cmd='List DATES 'SendFName.ReqCount.SentCount' LFORMAT="%D%T" TO 'ulist 
  387.             end;else do   
  388.                 cktime=FALSE
  389.                 cmd='List DATES 'SendFName.ReqCount.SentCount' LFORMAT="%D" TO 'ulist
  390.             end
  391.             Address Command cmd
  392.             call open('UFile',ulist,'R')
  393.             UpDt.ReqCount.SentCount=readln('UFile')
  394.             call close('UFile')
  395.             if ~debug then call Delete(ulist)
  396.             if cktime then UpDt.ReqCount.SentCount=space(translate(UpDt.ReqCount.SentCount,"",":"),0)
  397.             if verbose then address "LOGPROC" 'PutLog 'loggroup time() Line "File Date Read:"UpDt.ReqCount.SentCount
  398.  
  399.             Mon=right('00'||(pos(substr(UpDt.ReqCount.SentCount,4,3),'JanFebMarAprMayJunJulAugSepOctNovDec')+2)/3,2)
  400.  
  401.             if cktime then Jdate.ReqCount.SentCount=right(UpDt.ReqCount.SentCount,2)||Mon||left(UpDt.ReqCount.SentCount,2)||right(UpDt.ReqCount.SentCount,8)
  402.                 else Jdate.ReqCount.SentCount=right(UpDt.ReqCount.SentCount,2)||Mon||left(UpDt.ReqCount.SentCount,2)
  403.  
  404.             if verbose then address "LOGPROC" 'PutLog 'loggroup time() Line "File Date Calc:"Jdate.ReqCount.SentCount
  405.         end;else do
  406.             /* FTS006 update request */
  407.             x=statef(SendFName.ReqCount.SentCount)
  408.             JDate.ReqCount.SentCount=(86400 * 365 * 8)+(2 * 86400)+(((word(x,5))*86400)+(word(x,6)*60))
  409.         end
  410.         if (UDT.ReqCount="+") & (JDate.ReqCount.SentCount < Update.ReqCount) then do
  411.             SendFName.ReqCount.SentCount="Update request failed: File older than requested."
  412.             sendit=FALSE
  413.         end
  414.         if (UDT.ReqCount="-") & (JDate.ReqCount.SentCount > Update.ReqCount) then do
  415.             SendFName.ReqCount.SentCount="Update request failed: File newer than requested."
  416.             sendit=FALSE
  417.         end
  418.         if verbose then address "LOGPROC" 'PutLog 'loggroup time() Line SendFName.ReqCount.SentCount
  419.     end 
  420. end
  421. if sendit then do
  422.     /* get FileName returned for a magic request */
  423.     Mname.ReqCount.SentCount=get_fn(SendFname.ReqCount.SentCount)
  424.     if Fname.ReqCount=Mname.ReqCount.SentCount then Mname.ReqCount.SentCount=""
  425.     if ~debug then call queueadd(SendFName.ReqCount.SentCount,XQ_IMMEDIATE)
  426.         else address "LOGPROC" 'PutLog 'loggroup time() Line script "Queued" SendFname.ReqCount.SentCount
  427. end
  428. return sendit
  429.  
  430. writepkt:
  431. if Human then do
  432.     cr='0a'x;packet_name="T:"||translate(strip(remote_sysop),'_'," ")||"."||date("I")||time("S")
  433.     pbuf=""
  434. end;else do
  435.     magicnum=x2d(time('s'))+randu(x2d(Pragma('ID')))+ (randu(x2d(time('s')) ) * 999999)+(random() * 1000000)  
  436.     serial=reverse(right("0000"x||c2x(magicnum), 8))
  437.     packet_name="T:"||serial||".PKT"
  438.  
  439.     /* create some data in packet format */
  440.     d=date("S");t=time("N")
  441.     parse var t hh":"mm":"ss
  442.     yr=reverse(right("00"x||d2c(left(d,4)),2))
  443.     mh=reverse(right("00"x||d2c((substr(d,5,2)-1)),2))
  444.     dy=reverse(right("00"x||d2c(substr(d,7,2)),2))
  445.     hr=reverse(right("00"x||d2c(hh),2))
  446.     mn=reverse(right("00"x||d2c(mm),2))
  447.     sc=reverse(right("00"x||d2c(ss),2))
  448.  
  449.     zo=reverse(right("00"x||d2c(myaddress.zone),2))
  450.     ndo=reverse(right("00"x||d2c(myaddress.node),2))
  451.     nto=reverse(right("00"x||d2c(myaddress.net),2))
  452.     po=reverse(right("00"x||d2c(myaddress.point),2))
  453.  
  454.     zd=reverse(right("00"x||d2c(hisaddress.zone),2))
  455.     ndd=reverse(right("00"x||d2c(hisaddress.node),2))
  456.     ntd=reverse(right("00"x||d2c(hisaddress.net),2))
  457.     pd=reverse(right("00"x||d2c(hisaddress.point),2))
  458.  
  459.     pbuf=ndo||ndd||yr||mh||dy||hr||mn||sc||copies("00"x,2) ||"0200"x
  460.     pbuf=pbuf||nto||ntd||"DA"x||d2c(substr(sv,2,2))||copies("00"x, 8)
  461.     pbuf=pbuf||zo||zd||copies("00"x,2)||reverse(right("01"x||"00"x,2))
  462.     pbuf=pbuf||"00"x||d2c(substr(sv,5,2))||reverse(right("00"x||"01"x,2))
  463.     pbuf=pbuf||zo||zd||po||pd||"ROOF"||"0200"x||ndo||ndd||nto||ntd||"11000000"x 
  464.     pbuf=pbuf||left(date(),6) right(date(),2) "" time()||"00"x||remote_sysop||"00"x
  465.     pbuf=pbuf||sysop||"00"x||"Results of your file request"||"00"x
  466.  
  467.     if myaddress.zone~=hisaddress.zone then pbuf=pbuf||"01"x||"INTL" hisaddress.zone":"hisaddress.net"/"hisaddress.node myaddress.zone":"myaddress.net"/"myaddress.node||cr
  468.         else pbuf=pbuf||"01"x||"MSGTO:" hisaddress.zone":"hisaddress.net"/"hisaddress.node||cr
  469.     if myaddress.point~=0 then pbuf=pbuf||"01"x||"FMPT" myaddress.point||cr
  470.     if hisaddress.point~=0 then pbuf=pbuf||"01"x||"TOPT" hisaddress.point||cr
  471.  
  472.     pbuf=pbuf||"01"x||"MSGID: "myaddress.zone':'myaddress.net'/'myaddress.node'.'myaddress.point' 'd2x((date('I') * 86400)+time("S")+252460600) ||cr
  473.     pbuf=pbuf||"01"x||"PID: Roof/"script sv||cr
  474. end /* Not Human */
  475.  
  476.     if Header~="" then pbuf=pbuf||cr||Header||cr
  477.     if exists(AcctFile||'.M') then call addmsg
  478.     if FirstCall~="" then pbuf=pbuf||cr||FirstCall||cr
  479.  
  480.     if Human then pbuf=pbuf||cr||'The following are the results of your Grab session:'||cr||cr
  481.         else pbuf=pbuf||cr||'The following are the results of your File Request:'||cr||cr
  482.  
  483.     pbuf=pbuf||arg(1)||cr||cr
  484.  
  485.     If Tail~="" & ~Human then  pbuf=pbuf||cr||Tail||cr
  486.  
  487.     If Human & Listed & VHuman~="" then pbuf=pbuf||cr||VHuman||cr
  488.  
  489.     pbuf=pbuf||cr||"--- The Roof File Request Server "sv||cr||cr
  490.     if ~Human then pbuf=pbuf||"000000"x
  491.  
  492.     if ~open('packet',packet_name,"W") then do
  493.         address "LOGPROC" 'PutLog 'loggroup time() Line script "Couldn't open packet-file ["packet_name"]"
  494.         return 20
  495.     end
  496.     call writech('packet',pbuf)
  497.     call close('packet')
  498.     if verbose then address "LOGPROC" 'PutLog 'loggroup time() Line script "Queueing response packet" packet_name
  499.     call queueadd(packet_name, XQ_IMMEDIATE+XQ_DELETE)
  500. return 0
  501.  
  502.     
  503. addmsg:
  504. call open('am',AcctFile||'.M','R')
  505. pbuf=pbuf||" The sysop left this personal message for you:"||cr
  506. do while ~eof('am')
  507.     mline=readln('am')
  508.     y=pos(cr,mline)
  509.     if y~=0 then pbuf=pbuf||mline
  510.         else pbuf=pbuf||mline||cr
  511. end
  512. call close('am')
  513. call delete(AcctFile||'.M')
  514. return
  515.  
  516.  
  517. send:
  518. Address VALUE upper(wplport)||line
  519. 'Print' quote||arg(1)||quote
  520. 'Send' quote||arg(1)||quote
  521. Address
  522. return
  523.  
  524. queueadd:
  525. if debug then return
  526. file=upper(arg(1))
  527. flags=arg(2)
  528. sendas=get_fn(file)
  529. work=NULL
  530. QUERY.XQ_NAME=file
  531. QUERY.XQ_SITE=xfq_site_object
  532. work=XfqFindWork(QUERY)
  533. if work=NULL then do
  534.     if ~XfqAddWorkQuick(remote_address,file,sendas,120,flags) then do
  535.         address "LOGPROC" 'PutLog 'loggroup time() Line script 'Queue 'file' Failed:'XFQERRORMSG remote_address
  536.         drop XFQERRORCODE XFQERRORMSG
  537.     end;else do
  538.         address "LOGPROC" 'PutLog 'loggroup time() Line script 'Queued 'file' as' sendas
  539.         if Human then call send(' Sending 'file' as 'sendas'\r\n')
  540.     end
  541. end;else do
  542.     call XfqUnlockWork(work)
  543.     address "LOGPROC" 'PutLog 'loggroup time() Line script file 'already queued'
  544. end
  545. if work~=NULL then call XfqDropObject(work)
  546. return 0
  547.  
  548. get_dlgfd:
  549. fn=translate(FDesc.ReqCount.SentCount,"",'1b'x)
  550. if ~open('dx',fn,'r') then return "Sorry, DLG description is unavailable"
  551. tmpbuf=readch('dx',word(statef(fn),2))
  552. call close('dx')        
  553. return substr(tmpbuf,lastpos('00'x,tmpbuf)+1)
  554.  
  555. get_tadesc:
  556. fn=SendFName.ReqCount.SentCount||'.desc'
  557. if ~open('dx',fn,'r') then return "Sorry, TransAmiga description is unavailable"
  558. tmpbuf=readch('dx',word(statef(fn),2))
  559. call close('dx')        
  560. return tmpbuf
  561.  
  562. /* get filename */
  563. get_fn:
  564. if LastPos('/', arg(1))~=0 then return SubStr(arg(1), LastPos('/', arg(1))+1)
  565.     else if LastPos(':', arg(1))~=0 then return SubStr(arg(1), LastPos(':', arg(1))+1)
  566.         else return arg(1)
  567.  
  568. Syntax:
  569. call template_oops "Syntax(RC="||RC||")" sigl RC
  570. IOErr:
  571. call template_oops "IOErr" sigl
  572. template_oops: 
  573. parse arg what badline code
  574. if code~="" then  LogBuf=LogBuf||date() time() "ERR:"what errortext(code)||lf
  575.     else LogBuf=LogBuf||date() time() "ERR:"what||lf
  576. LogBuf=LogBuf||date() time() "ERR: Line:"badline strip(sourceline(badline))||lf
  577. GoodBye:
  578. x=XfqReleaseMailer(xfq_site_object)
  579. call XfqDropObject(xfq_site_object)
  580. if work~=NULL then call XfqDropObject(work)
  581. call XfqClose()
  582.  
  583. if AccBuf~="" then do
  584.     address "LOGPROC" 'PutLog 'loggroup time() Line "Updating account"
  585.     call open('Acct',AcctFile,'W')
  586.     call Writech('Acct',AccBuf||lf)
  587.     call close('Acct')
  588. end
  589.  
  590. LogBuf=LogBuf||date() time()' RFS session Ending'||lf
  591.  
  592. if LogFile~="" then do
  593.     if exists(LogFile) then call open('log',LogFile,'A')
  594.         else call open('log',LogFile,'W')
  595.     call writech('log',LogBuf||lf)
  596.     call close('log')
  597. end;else do
  598.     i=1
  599.     loglen=length(LogBuf)
  600.     do while i < loglen+1
  601.         alen=pos('0a'x, LogBuf, i)-i
  602.         aline=substr(body,i,alen)
  603.         address "LOGPROC" 'PutLog 'loggroup Line aline
  604.         i=i+alen+1
  605.     end
  606. end
  607. if ~debug then call delete(infile)
  608. address "LOGPROC" 'PutLog 'loggroup time() Line 'RFS session with' remote_address 'terminated'
  609. Exit
  610.  
  611. setconfig:
  612. if ~open('cfg',"RAM:RFS.cfg",'r') then 
  613.     if ~open('cfg',"CFG:RFS.cfg",'r') then address "LOGPROC" 'PutLog 'loggroup time() Line 'RFS cfg failed'
  614.     do while ~eof('cfg')
  615.         x=readln('cfg')
  616.         if x="" | left(x,1)=" " | left(x,2)='/*' | left(x,2)='*/' then iterate
  617.         interpret x
  618.     end
  619. call close('cfg')
  620. return
  621.  
  622. lower:
  623. return(bitor(arg(1),'20'x))
  624.